home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / BTREES4.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  5KB  |  184 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program BTrees4;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for opening an object B tree. }
  13.  
  14. uses Objects, Containr, ctBTrees,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   String20 = string[20];
  23.   String18 = string[18];
  24.   String15 = string[15];
  25.   String25 = string[25];
  26.  
  27. type
  28.   PContact = ^TContact;
  29.   TContact = object (TObject)
  30.       FirstName,
  31.       LastName,
  32.       Phone,
  33.       Company : PString;
  34.     constructor Init(ALastName: String20; AFirstName: String15;
  35.       APhone : String18; ACompany : String25);
  36.     constructor Load(var S: TStream);
  37.     destructor Done; virtual;
  38.     procedure Store(var S: TStream);
  39.   end; { TContact }
  40.  
  41. constructor TContact.Init(ALastName: String20; AFirstName: String15;
  42.   APhone : String18; ACompany : String25);
  43. begin
  44.   FirstName := NewStr(AFirstName);
  45.   LastName := NewStr(ALastName);
  46.   Phone := NewStr(APhone);
  47.   Company := NewStr(ACompany);
  48. end;
  49.  
  50. constructor TContact.Load(var S: TStream);
  51. begin
  52.   FirstName := S.ReadStr;
  53.   LastName := S.ReadStr;
  54.   Phone := S.ReadStr;
  55.   Company := S.ReadStr;
  56. end;
  57.  
  58. destructor TContact.Done;
  59. begin
  60.   DisposeStr(FirstName);
  61.   DisposeStr(LastName);
  62.   DisposeStr(Phone);
  63.   DisposeStr(Company);
  64. end;
  65.  
  66. procedure TContact.Store(var S: TStream);
  67. begin
  68.   S.WriteStr(FirstName);
  69.   S.WriteStr(LastName);
  70.   S.WriteStr(Phone);
  71.   S.WriteStr(Company);
  72. end;
  73.  
  74. const
  75.   RContact : TStreamRec = (
  76.     ObjType: 1000;
  77.     VmtLink: Ofs(TypeOf(TContact)^);
  78.     Load:    @TContact.Load;
  79.     Store:   @TContact.Store);
  80.  
  81. type
  82.   PContactList = ^TContactList;
  83.   TContactList = object(TObjectBTree)
  84.     function KeyOf(Item : Pointer) : Pointer; virtual;
  85.   end; { TContactList }
  86.  
  87. function TContactList.KeyOf(Item : Pointer) : Pointer;
  88. begin
  89.   KeyOf := PContact(Item)^.LastName;
  90. end;
  91.  
  92. procedure DisplayContacts(ContactList : PGraph);
  93.  
  94.   procedure PrintInfo (Item : Pointer); far;
  95.   begin
  96.     with PContact(Item)^ do
  97.       writeln(LastName^, '':15 - Length(LastName^),
  98.         FirstName^, '':15 - Length(FirstName^),
  99.         Phone^, '':20 - Length(Phone^),
  100.         Company^, '':20 - Length(Company^));
  101.   end;
  102.  
  103. begin
  104.   ContactList^.ForEach(@PrintInfo);
  105. end;
  106.  
  107. procedure DisplayFirst(ContactList : PGraph);
  108. var
  109.   Item : Pointer;
  110. begin
  111.   Item := ContactList^.First;
  112.   Writeln('First item:');
  113.   if Item <> nil
  114.     then with PContact(Item)^ do
  115.            writeln(LastName^, '':15 - Length(LastName^),
  116.              FirstName^, '':15 - Length(FirstName^),
  117.              Phone^, '':20 - Length(Phone^),
  118.              Company^, '':20 - Length(Company^));
  119.   ContactList^.DoneItem(Item); { not required }
  120. end;
  121.  
  122. procedure DisplayLast(ContactList : PGraph);
  123. var
  124.   Item : Pointer;
  125. begin
  126.   Item := ContactList^.Last;
  127.   Writeln('Last item:');
  128.   if Item <> nil
  129.     then with PContact(Item)^ do
  130.            writeln(LastName^, '':15 - Length(LastName^),
  131.              FirstName^, '':15 - Length(FirstName^),
  132.              Phone^, '':20 - Length(Phone^),
  133.              Company^, '':20 - Length(Company^));
  134.   ContactList^.DoneItem(Item); { not required }
  135. end;
  136.  
  137. procedure FindLastName(ContactList : PGraph; LastName : string);
  138. var
  139.   Item : Pointer;
  140. begin
  141.   Item := ContactList^.KeyFirst(@LastName);
  142.   Writeln('Item found with last name ''', LastName, ''':');
  143.   if Item <> nil
  144.     then with PContact(Item)^ do
  145.            writeln(LastName^, '':15 - Length(LastName^),
  146.              FirstName^, '':15 - Length(FirstName^),
  147.              Phone^, '':20 - Length(Phone^),
  148.              Company^, '':20 - Length(Company^));
  149.   ContactList^.DoneItem(Item); { not required }
  150. end;
  151.  
  152. var
  153.   ContactList : PContactList;
  154.   Contact : TContact;
  155.   Stream : PBufStream;
  156.  
  157. begin
  158.   ClrScr;
  159.  
  160.   { Open the stream }
  161.   Stream := New(PBufStream, Init('btrees.dat', stOpen, 1024));
  162.  
  163.   { Register the TContact object }
  164.   RegisterType(RContact);
  165.  
  166.   { Open the B tree }
  167.   ContactList := New(PContactList, Open(Stream, 5));
  168.  
  169.  
  170.   DisplayContacts(ContactList);
  171.   Writeln;
  172.   DisplayFirst(ContactList);
  173.   Writeln;
  174.   DisplayLast(ContactList);
  175.   Writeln;
  176.   FindLastName(ContactList, 'Wagner');
  177.  
  178.   { Dispose of the B tree }
  179.   Dispose(ContactList, Done);
  180.  
  181.   { Dispose of the stream }
  182.   Dispose(Stream, Done);
  183. end.
  184.